home *** CD-ROM | disk | FTP | other *** search
/ Aminet 31 / Aminet 31 (1999)(Schatztruhe)[!][Jun 1999].iso / Aminet / dev / basic / NewCommandSet.lha / NewCommandSet_V1.80 / Tools / NewFDConvert / newfdconvert.asc < prev    next >
Text File  |  1999-03-27  |  8KB  |  366 lines
  1. ; fdconvert.bb2 with added file requesters!
  2.  
  3. ; Right, now create Resource fixed
  4.  
  5. ; Now the program presents you the best library ID !!!
  6.  
  7. ; And now the executable don' t suxx if the library isn' t available...
  8.  
  9. v$="$VER: NewFDConvert v1.0 (5-11-1998) ACID/JLB"
  10.  
  11. WBStartup
  12. NoCli
  13. FindScreen 0
  14. MaxLen p$=180:MaxLen f$=180:MaxLen lib$=180
  15. p$="RAM:":lib$="LIBS:"
  16.  
  17. *SC.Screen=Peek.l(Addr Screen(0))     ; get a pointer to screen
  18. *SCFONT.TextAttr=*SC.Screen\Font      ; and to the screen's font
  19. HEIGHT_WBFONT.b=(*SCFONT.TextAttr\ta_YSize) ; get font height
  20. fname$=Peek$(*SCFONT.TextAttr\ta_Name); and font name
  21.  
  22. LoadFont 0,fname$,HEIGHT_WBFONT       ; load font name,font height
  23.  
  24. ww.w=400                              ; width of window
  25. wh.w=100                              ; height of window
  26. wx.w=ScreenWidth/2-ww/2               ; centre...
  27. wy.w=ScreenHeight/2-wh/2              ; ...window
  28.  
  29. If Window (0,wx,wy,ww,wh,$20140e,"NewFDConvert",1,2)=0
  30.   Request "NewFDConvert","Failed to open window!","END"
  31.   End                                 ; quit if window can't open
  32. EndIf
  33.  
  34. NPrint " NewFDConvert by James L Boyd, based on :"
  35. WPrintScroll
  36. NPrint " FDConv V ?.? - Written by Mark Sibly"
  37. WPrintScroll
  38. NPrint " V2.0 updated by Andre Bergmann"+Chr$(10)
  39. WPrintScroll
  40. NPrint ""
  41. WPrintScroll
  42.  
  43. DEFTYPE.l
  44. ;
  45. ;fdinfo prog... suss out an fd file, and return library offsets!
  46. ;
  47. Statement align{}
  48. ;
  49. SHARED co$
  50. ;
  51. l.q=Len(co$)
  52. If l/2<>Int(l/2) Then co$+Chr$(0)
  53. ;
  54. End Statement
  55.  
  56. Statement fillin{src.l} ;src=source to change
  57. ;
  58. SHARED co$
  59. ;
  60. co$=Left$(co$,src)+Mkl$(Len(co$))+Mid$(co$,src+5)
  61. ;
  62. End Statement
  63.  
  64. Statement dir{}
  65. SHARED bestlibnr.w
  66.   bestlibnr.w=255
  67.   libnr.w=0
  68.   dev$="BlitzLibs:AmigaLibs/"
  69.   lock.l=Lock_(&dev$,-2)
  70.   If lock
  71.     infoadr.l=AllocMem_(260,0)
  72.     If infoadr
  73.       ok=Examine_(lock,infoadr)
  74.       Repeat
  75.         ok=ExNext_(lock,infoadr)
  76.         If ok AND Peek.l(infoadr+4)=-3 AND Instr(UCase$(Peek$(infoadr+8)),".INFO")=0
  77.             rfile$=dev$+Peek$(infoadr+8)
  78.             fh.l=Open_(&rfile$,1005)
  79.             If fh
  80.               Seek_ fh,36,#OFFSET_CURRENT ;36 & 86
  81.               Read_ fh,&libnr,2
  82.               If libnr<bestlibnr
  83.                 bestlibnr=libnr
  84.               EndIf
  85.               Close_ fh
  86.             EndIf
  87.         EndIf
  88.       Until ok=0
  89.       FreeMem_ infoadr,260
  90.     EndIf
  91.     UnLock_(lock)
  92.     bestlibnr-1
  93.   Else
  94.     NPrint "Sorry, not able to get device lock..."
  95.     WPrintScroll
  96.   EndIf
  97. End Statement
  98.  
  99. fd$=ASLFileRequest$("Select .fd file",p$,f$,"#?.fd")
  100.  If fd$="" OR f$="" Then End
  101.  f$=""
  102.  
  103. dest$="blitzlibs:amigalibs/"
  104.  
  105. Dim n$(1000),h$(1000),p$(1000),o.w(1000)
  106. Dim l$(10),ln(10) ;max libs split-up
  107.  
  108. If ReadFile(0,fd$)
  109.   NPrint "Examining FD File..."
  110.   WPrintScroll
  111.   FileInput 0:Gosub sussfd:CloseFile 0:DefaultInput
  112.   ;
  113.   ;ok... fd file sussed - now to make output file...
  114.   ;
  115.   Gosub makelib
  116.   ;
  117. Else
  118.   NPrint "Couldn't open file for reading."
  119.   WPrintScroll
  120.   End
  121. EndIf
  122.  
  123. End
  124.  
  125. .makelib  ;n=number of commands...
  126. here0
  127. ll.l=OldOpenLibrary_(&li$)
  128. If ll
  129.   CloseLibrary_ ll:islib=-1
  130. Else
  131.   ll.l=OpenResource_(&li$)
  132.   If ll
  133.     islib=0
  134.   Else
  135. li$=ASLFileRequest$("Library name",lib$,f$,"#?.library")
  136. li$=f$
  137.     If li$="" Then Return
  138.     Goto here0
  139.   EndIf
  140. EndIf
  141. ;
  142. ;li$=library name! - generate amigalibs name
  143. ;
  144. nl=(n-1)/127+1  ;how many libs to make
  145. NPrint "Library will require ",nl," Amigalibs files..."
  146. WPrintScroll
  147. For k=1 To nl
  148. fh.l=Open_(dest$+li$+Str$(1),#MODE_OLDFILE)
  149. If fh
  150.   Seek_ fh,36,#OFFSET_CURRENT ;36 & 86
  151.   Read_ fh,&libnr.w,2
  152.   Close_ fh
  153.   Request "NewFDConvert","Library already exists! Library ID: "+Str$(libnr),"Oh...":End
  154.   WPrintScroll
  155. Else
  156.   dir{}
  157. EndIf
  158. here
  159. r$="Use dev/basic/blitzman to find free library numbers..."
  160. r$+Chr$(10)+"Enter new library number (1-255 or 0 to abort) :"
  161. ln(k)=RTEZGetLongRange("NewFDConvert",r$,0,255,bestlibnr)
  162. WPrintScroll
  163. If ln(k)=0
  164.   End
  165. EndIf
  166. If ln(k)>255 OR ln(k)<1
  167.   NPrint "Illegal library ID":Goto here
  168.   WPrintScroll
  169. EndIf
  170. Next
  171. ln=ln(1)
  172. ;
  173. li2$=li$
  174. clearup:k=Instr(li2$,":"):If k Then li2$=Mid$(li2$,k+1):Goto clearup
  175. clearup2:k=Instr(li2$,"/"):If k Then li2$=Mid$(li2$,k+1):Goto clearup
  176. ;
  177. nn=127:li=0
  178. ;
  179. For tk=1 To n
  180. ;
  181. nn+1
  182. If nn=128
  183.   ;
  184.   If li Then Gosub libdone
  185.   ;
  186.   li+1
  187.   If WriteFile(0,dest$+li2$+Str$(li))=0
  188.     NPrint "Error creating File : ",li$+Str$(li)
  189.     WPrintScroll
  190.     Pop For:Return
  191.   EndIf
  192.   ;
  193.   co$=Mkl$(0)+Mki$(ln(li))+String$(Chr$(0),20)
  194.   If li=1 Then co$+Mki$(1) Else co$+Mki$(0)
  195.   co$+String$(Chr$(0),20)
  196.   nn=1:NPrint "-------------------- NEW LIB -----------------------"
  197.   WPrintScroll
  198.   ;
  199. EndIf
  200. ;
  201. NPrint "CREATING : ",n$(tk),"_",suf$," ",h$(tk)," ",p$(tk)
  202. WPrintScroll
  203. co$+Mki$(6)+Mkl$(0)+Mki$(ln(1))+Mki$(o(tk)) ;type and link
  204. ;
  205. p$=Mid$(p$(tk),2)
  206. While Left$(p$,1)="a" OR Left$(p$,1)="d"
  207.   If Left$(p$,1)="a"
  208.     co$+Chr$(Val(Mid$(p$,2,1))+16)
  209.   Else
  210.     co$+Chr$(Val(Mid$(p$,2,1)))
  211.   EndIf
  212.   p$=Mid$(p$,4)
  213. Wend
  214. ;
  215. co$+Chr$(-1)
  216. align{}
  217. co$+Mkl$(0)+Mki$(0)+n$(tk)+"_"+suf$+Chr$(0)+h$(tk)+Chr$(0)
  218. align{}
  219. ;
  220. Next
  221. ;
  222. If co$ Then Gosub libdone
  223. ;
  224. Return
  225.  
  226. .libdone
  227. ;
  228. If li=1 ;first one - create 'openlibrary' stuff!
  229.   ;
  230.   ;make 'init' nullsub!
  231.   ;
  232.   fillin{$16}
  233.   co$+String$(Chr$(0),12):iat=Len(co$)
  234.   co$+Mkl$(0)+Mkl$(0)
  235.   ;
  236.   ;make 'finit' nullsub!
  237.   ;
  238.   fillin{$1c}
  239.   co$+String$(Chr$(0),6)+Mki$(ln(1))+Mki$($1100)+Mki$(0)
  240.   co$+Mkl$(0):fat=Len(co$)
  241.   co$+Mkl$(0)+Mkl$(0)
  242.   ;
  243.   co$+Mki$(-1)+Mkl$(0)
  244.   ;
  245.   ;make 'libinit' code!
  246.   ;
  247.   fillin{iat}
  248.   co$+Mkl$($2c780004)         ;     move.l   4.w,a6
  249.   If islib
  250.     co$+Mkl$($43fa0022)         ;loop lea      libname(pc),a1
  251.   Else
  252.     co$+Mkl$($43fa001d)
  253.   EndIf
  254.   co$+Mki$($7000)             ;     moveq    #0,d0
  255.   co$+Mki$($4eae)
  256.   If islib
  257.     co$+Mki$(-552)            ;     jsr      openlibrary(a6)
  258.   Else
  259.     co$+Mki$(-498)            ;     jsr      openresource(a6)
  260.   EndIf
  261. ;  co$+Mki$($4a80)             ;     tst.l    d0
  262. ;  co$+Mkl$($6700fff4)         ;     beq      loop
  263.   co$+Mki$($4e75)             ;     rts
  264.   ;
  265.   ;make 'libfinit' code!
  266.   ;
  267.   fillin{fat}
  268.   If islib
  269. ;    co$+Mkl$($2c780004)   ;     move.l    4.w,a6
  270. ;    co$+Mkl$($4eeefe62)   ;     jmp       -$19e(a6)
  271.  
  272. ; Well, the fellowing code should create something like this:
  273. ; MOVE.l  a1,d0
  274. ; TST.l d0
  275. ; BEQ skip
  276. ; MOVEA.l 4,a6
  277. ; JSR -$19e(a6)
  278. ; skip:
  279. ; RTS
  280.  
  281.     co$+Mkl$($20094A80)
  282.     co$+Mkl$($6700000C)
  283.     co$+Mkl$($2C790000)
  284.     co$+Mkl$($00044EAE)
  285.     co$+Mkl$($FE624E75)
  286.     co$+Mkl$($70004E75)
  287.   Else
  288.     co$+Mki$($4e75)
  289.   EndIf
  290.   ;
  291.   ;add 'name.library'
  292.   ;
  293.   co$+li$+Chr$(0)
  294.   ;
  295.   ;All Code Done! - now for reloc stuff
  296.   ;
  297.   re$=Mkl$($3ec)+Mkl$(4)+Mkl$(0)+Mkl$($16)+Mkl$($1c)
  298.   re$+Mkl$(iat)+Mkl$(fat)+Mkl$(0)
  299.   ;
  300. Else
  301.   ;
  302.   co$+Mki$(-1)+Mkl$(0)
  303.   ;
  304. EndIf
  305. ;
  306. While (Len(co$) AND 3)
  307.   co$+Chr$(0)
  308. Wend
  309. ;
  310. ;Now for header stuff
  311. ;
  312. cl=Len(co$)/4
  313. ;
  314. in$=Mkl$($3f3)+Mkl$(0)+Mkl$(1)+Mkl$(0)+Mkl$(0)
  315. in$+Mkl$(cl)+Mkl$($3e9)+Mkl$(cl)
  316. ;
  317. FileOutput 0
  318. Print in$,co$,re$,Mkl$($3f2)
  319. CloseFile 0:DefaultOutput
  320. ;
  321. co$="":re$="":Return
  322.  
  323. .sussfd
  324. n=0:bi=-30:li$="":gen=-1
  325. While NOT Eof(0)
  326.   l$=Edit$(256)
  327.   If Left$(l$,1)<>"*"
  328.     If Left$(l$,2)="##"
  329.       c$=LCase$(Mid$(l$,3)):c$=StripLead$(c$,32)
  330.       If Left$(c$,6)="public" Then gen=-1
  331.       If Left$(c$,7)="private" Then gen=0
  332.       If Left$(c$,3)="end" Then Return
  333.       If Left$(c$,4)="bias" Then bi=-Val(Mid$(c$,5))
  334.     Else
  335.       If gen
  336.         b1=Instr(l$,"(")     ;first bracket
  337.         b2=Instr(l$,"(",b1+1) ;second bracket
  338.         If b1>0 AND b2>0
  339.           n+1
  340.           o(n)=bi
  341.           n$(n)=Left$(l$,b1-1)
  342.           h$(n)=Mid$(l$,b1,b2-b1):If h$(n)="()" Then h$(n)=""
  343.           p$(n)=LCase$(Mid$(l$,b2))
  344.         Else
  345.           NPrint "Error in file :"
  346.           WPrintScroll
  347.           NPrint l$
  348.           WPrintScroll
  349.         EndIf
  350.       EndIf
  351.       bi-6
  352.       ;
  353.     EndIf
  354.   Else
  355.     n$=Mid$(l$,2):n$=StripLead$(n$,32)
  356.     If Left$(n$,1)=Chr$(34)
  357.       n2=Instr(n$,Chr$(34),2)-2
  358.       If n2>0
  359.         li$=Mid$(n$,2,n2)
  360.       EndIf
  361.     EndIf
  362.   EndIf
  363. Wend
  364. Return
  365.  
  366.